home *** CD-ROM | disk | FTP | other *** search
/ NeXT Education Software Sampler 1992 Fall / NeXT Education Software Sampler 1992 Fall.iso / Mathematics / Notebooks / SigProc2.0 / Packages / SignalProcessing / Support / Tree.m < prev   
Encoding:
Text File  |  1992-08-18  |  4.6 KB  |  190 lines
  1. (*  :Title:    Tree manipulation routines  *)
  2.  
  3. (*  :Authors:    Brian Evans, James McClellan  *)
  4.  
  5. (*
  6.     :Summary:    Extend tree manipulation abilities in Mathematica
  7.         (see also the standard package DiscreteMath`Tree`)
  8.  *)
  9.  
  10. (*  :Context:    SignalProcessing`Support`Tree`  *)
  11.  
  12. (*  :PackageVersion:  2.7    *)
  13.  
  14. (*
  15.     :Copyright:    Copyright 1989-1991 by Brian L. Evans
  16.         Georgia Tech Research Corporation
  17.  
  18.     Permission to use, copy, modify, and distribute this software
  19.     and its documentation for any purpose and without fee is
  20.     hereby granted, provided that the above copyright notice
  21.     appear in all copies and that both that copyright notice and
  22.     this permission notice appear in supporting documentation,
  23.     and that the name of the Georgia Tech Research Corporation,
  24.     Georgia Tech, or Georgia Institute of Technology not be used
  25.     in advertising or publicity pertaining to distribution of the
  26.     software without specific, written prior permission.  Georgia
  27.     Tech makes no representations about the suitability of this
  28.     software for any purpose.  It is provided "as is" without
  29.     express or implied warranty.
  30.  *)
  31.  
  32. (*  :History:    *)
  33.  
  34. (*  :Keywords:    tree data structure    *)
  35.  
  36. (*  :Source:    *)
  37.  
  38. (*  :Warning:    *)
  39.  
  40. (*  :Mathematica Version:  1.2 or 2.0  *)
  41.  
  42. (*  :Limitation:  *)
  43.  
  44. (*
  45.     :Discussion:    Trees are represented a list of lists.
  46.  
  47.             a0 ---> b1           -> g3
  48.                 |               |
  49.                  -> c1 ---> d2 ---> f3
  50.                     |
  51.                      -> e2
  52.  
  53.             would be represented as
  54.  
  55.             { a0, b1, {c1, {d2, f3, g3}, e2} }
  56.  
  57.         See also the standard package DiscreteMath`Tree`.
  58.  *)
  59.  
  60. (*  :Functions:  AddChildToTree DeleteFromTree InitTree SubTree  *)
  61.  
  62.  
  63. If [ TrueQ[ $VersionNumber >= 2.0 ],
  64.      $NewMessage[ System`General, "spell" ];
  65.      $NewMessage[ System`General, "spell1" ];
  66.      Off[ General::spell ];
  67.      Off[ General::spell1 ] ]
  68.  
  69.  
  70. (*  B E G I N     P A C K A G E  *)
  71.  
  72. BeginPackage [ "SignalProcessing`Support`Tree`" ]
  73.  
  74.  
  75. (*  U S A G E     I N F O R M A T I O N  *)
  76.  
  77. AddChildToTree::usage =
  78.     "AddChildToTree[tree, parent, newchild] adds newchild under \
  79.     every parent in tree."
  80.  
  81. DeleteFromTree::usage =
  82.     "DeleteFromTree[tree, node] deletes all nodes with info/name of node. \
  83.     If the node is a parent, then the entire subtree is pruned."
  84.  
  85. InitTree::usage =
  86.     "InitTree[root] returns an empty tree with a root of root."
  87.  
  88. SubTree::usage =
  89.     "SubTree[tree, head] returns the subtree with root head."
  90.  
  91. (*  E N D     U S A G E     I N F O R M A T I O N  *)
  92.  
  93.  
  94. Begin [ "`Private`" ]
  95.  
  96.  
  97. (*  M E S S A G E S  *)
  98.  
  99. AddChildToTree::empty = "Empty tree encountered."
  100. DeleteFromTree::empty = "Empty tree encountered."
  101.  
  102.  
  103. (*  B E G I N     P A C K A G E  *)
  104.  
  105. (*  AddChildToTree  *)
  106. AddChildToTree[ tree_, parent_, newchild_ ] :=
  107.     addchildtotree[tree, parent, newchild]
  108.  
  109. addchildtotree[ tree_, parent_, newchild_ ] :=
  110.     Replace[ add[tree, parent, newchild], addchildrules ] 
  111.  
  112. addchildrules = {
  113.     add[{}, parent_, newchild_] :> Message[ AddChildToTree::empty ],
  114.  
  115.     add[parent_, parent_, newchild_] :> { parent, newchild },
  116.  
  117.     add[List[parent_], parent_, newchild_] :> { parent, newchild },
  118.  
  119.     add[List[parent_, rest__], parent_, newchild_] :>
  120.         { parent, newchild } ~Join~
  121.         Map[ addchildtotree[#, parent, newchild]&, {rest} ],
  122.  
  123.     add[List[other_, rest__], parent_, newchild_] :>
  124.         { other } ~Join~
  125.           Map[ addchildtotree[#, parent, newchild]&, {rest} ] /;
  126.         ! SameQ[other, parent],
  127.  
  128.     add[x_, parent_, newchild_] :> x
  129. }
  130.  
  131. (*  DeleteFromTree *)
  132. (*    replace all deleted sections by an empty list {} to get new.  *)
  133. (*    use Complement to sort tree and remove all {}'s.            *)
  134. DeleteFromTree[ tree_, node_ ] :=
  135.     If [ SameQ[node, First[tree]],
  136.          { First[tree] } ~Join~ deletefromtree[Rest[tree], node],
  137.          deletefromtree[tree, node] ]
  138.  
  139. deletefromtree[ tree_, node_ ] :=
  140.          Replace[ delete[tree, node], deletenoderules]
  141.  
  142. deletenoderules = {
  143.     delete[{}, node_] :> Message[ DeleteFromTree::empty ],
  144.  
  145.     delete[node_, node_] :> {},
  146.     delete[List[node_], node_] :> {},
  147.     delete[List[node_, rest__], node_ ] :> {},
  148.  
  149.     delete[List[other_, rest__], node_] :>
  150.         { other } ~Join~
  151.           Select[ Map[ deletefromtree[#, node]&, {rest} ],
  152.               ! SameQ[#, {}] & ] /;
  153.         ! SameQ[other, node],
  154.  
  155.     delete[x_, node_] :> x
  156. }
  157.  
  158. (*  InitTree  *)
  159. InitTree[ root_ ] := { root }
  160.  
  161. (*  SubTree   *)
  162. SubTree[ tree_, head_ ] :=
  163.     Block [    { returntree },
  164.  
  165.         subtree[ curtree_ ] :=
  166.             Block [    {newflag},
  167.                 newflag = If [ SameQ[Head[curtree], List],
  168.                            SameQ[head, First[curtree]],
  169.                            SameQ[head, curtree] ];
  170.                 If [ newflag,
  171.                      returntree = curtree ];
  172.                 newflag ];
  173.  
  174.         returntree = {};
  175.         Scan [ ( If [ subtree[#], Return ] ) &, tree, Infinity ];
  176.         returntree ]
  177.  
  178.  
  179. (*  E N D     P A C K A G E  *)
  180.  
  181.  
  182. End[]
  183. EndPackage[]
  184.  
  185. If [ TrueQ[ $VersionNumber >= 2.0 ],
  186.      On[ General::spell ];
  187.      On[ General::spell1 ] ]
  188.  
  189. Null
  190.